COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE LOOP		SUBROUTINE LOOP(I,J,L,M,N)
C00035 ENDMK
C⊗;
	TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
	ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
	ENTRY	SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,FSCAN,NALF,BOX,PARCH
	ENTRY CODN
	EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
	EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ,HOMX
	EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE
			;	DIMENSION N(1)
MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13   
RC←14 ↔ NX←15	;**** AC'S 0,1,2,3,5  ARE USED IN 'PLACE' & 'FINDIT'!!
LOOP:	0		;	DO 1 NN=I+L,J+L,K
	MOVE	1,@4(16)
	SUB 	1,@3(16) 	; MM IS IN 1
	MOVE	2,@(16)
	ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
	MOVE	3,@1(16)
	ADD	3,@3(16)	;J+L
	MOVE	4,@2(16)	;K
	HRRZI	5,@5(16)		; ADR. OF N
	ADDI	2,-1(5)		; N(NN)
	ADDI	3,-1(5)
	JUMPL	4,LP3		; JUMP IF NEG. INCR.
	HRRM	1,.+1		; ADD IN MM 
LP1:	MOVE	6,(2)
	MOVEM	6,(2)		;N(NN)=N(NN+MM)
	CAIGE	2,(3)
	AOJA	2,LP1
	JRA	16,6(16)
LP3:	HRRM	1,.+1
LP2:	MOVE	6,(2)		;NEG. INCR.
	MOVEM	6,(2)
	CAILE	2,(3)
	SOJA	2,LP2
	JRA 	16,6(16)	;	END

PLACE:	0	;	FUNCTION PLACE(X)
;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
	MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
	FADR	2,RMOD+=9 	;END
	MOVMS	2
	MOVE 	0,.COMM.+=12	;R11
	FSBR	0,2
	JRA	16,1(16)

FINDIT:	0    ;	FUNCTION FINDIT(N)
	SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;;	HRRZI	2,PTR  ;	FINDIT=0
;;	ADDI	1,(2)  ;	L=PWDS(N)
;;	MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
;;	FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
;;	HRRZI	3,XRN     ;377	FINDIT=-1
;;	ADDI	3,(2)   ;	END
;;	MOVE 5,(3)   ; RN(L+1)
	MOVE 2,PTR-1(1)		;THESE 3 REPLACE ABOVE
	MOVE 5,XRN(2)
	CAME	5,[1.0]
	JRST	FNEG
	MOVEM	2,PTR+=251   ; SENDS BACK A NUM IN L
;;	MOVE	5,1(3)  ;RN(L+2)
	MOVE 5,XRN+1(2)
	CAME	5,.COMM.
FNEG:	SETO
	JRA	16,1(16)

DPYNEW:	0    ;	SUBROUTINE DPYNEW
	JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
	JUMP	[1]    ;	CALL ACCPOG(1)
	MOVE	2,DPY+=4251    ;	IF(IGO.GT.0)RETURN
	JUMPG	2,DB    ;	CALL DPYOUT(1)
	JSA	16,DPYOUT    ;	END
	JUMP	[1]
DB:	JRA	16,(16)

MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
	HRRZ	2,(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
	ADD     2,@1(16)  ; 	+I
	MOVE 3,2          ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
	ADD	2,@2(16)  ;	+JY         DIMENSION R(1)
	MOVE	2,-1(2)  ;	Y=R(JY+I)
			 	;	Z=ABS(Y)
				;	IF(Z.LT.100.)GO TO 1
				;  IF(I.GT.5)GO TO 1
;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
				;	Y=AMOD(Y,100.)
				;	Z=Z-ABS(Y)+ABS(X)
				;	IF(X)Z=-Z
				;	GO TO 2
    	FADR	2,@4(16)  ;1	Z=Y+W
	ADD	3,@3(16)     ;  +L
	MOVEM	2,-1(3)  ; PUT IT IN R(L+I)
	JRA	16,5(16)	; END

MVBX:	0   ;	SUBROUTINE MVBX(I)
;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
	HRRZI 1,XRN	; LOC OF XRN
	ADD    1,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
	MOVE 2,1
	ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
	MOVE 3,-1(2)
	FSBR	3,.COMM.+5
	FMPR	3,.COMM.+=25  ; *RDIS
	FADR	3,.COMM.+=9   ; +R8
	ADD	1,.COMM.+=24   ; + L
	MOVEM 3,-1(1)
	JRA	16,1(16)

JUGGLE:	0    ;	SUBROUTINE JUGGLE
;	IMPLICIT INTEGER(A-Z)
;	REAL PWDS,RN
;	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
;     COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
	SOS	PTR+=250	;ITEM=ITEM-1
	HRRZI	15,XRN	;	JX=RN(MEDIT)+3   WD CNT OF OLD ITEM
	ADD	15,DPY+=4250	;C  I-IX IS WD CNT OF NEW ITEM
	KIFIX 14,-1(15)		;MOVE	14,-1(15)
	ADDI	14,3  		; JX
	MOVE	13,PTR+=253	;JY=IX
	MOVE	11,PTR+=252	; I
	SUB	11,13
	SUB	11,14		;Z=I-IX-JX    SPACE CHANGE
	JUMPL	11,J2751   	;IF(Z)2751,172,751
	JUMPE	11,J172
	MOVE	5,PTR+=252 ;751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
	SUBI	5,1
	MOVE	10,DPY+=4250
	ADD	10,14
	JSA	16,LOOP
	JUMP	5
	JUMP	10
	JUMP	[-1]
	JUMP	11
	JUMP	[0]
	JUMP	XRN
	ADD	13,11		;JY=IX+Z
	JRST	J172		;GO TO 172
J2751:	ADD	14,DPY+=4250 ;2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
	ADD	14,11
	MOVE	5,11
	ADD	5,PTR+=253
	SOJ	5,
	MOVN	10,11
	JSA	16,LOOP
	JUMP	14
	JUMP	5
	JUMP	[1]
	JUMP	[0]
	JUMP	10
	JUMP	XRN
				;172	J=RN(JY)+2	
J172:	KIFIX 12,XRN-1(13)	;MOVE 12,XRN-1(13)
	ADDI	12,2		; J IS IN 12
	JSA	16,LOOP		;CALL LOOP(0,J,1,MEDIT,JY,RN)
	JUMP	[0]
	JUMP	12
	JUMP	[1]
	JUMP	DPY+=4250	; MEDIT
	JUMP 	13		; JY
	JUMP	XRN
	MOVE	12,PTR+=253	; I=IX+Z
	ADD	12,11		; Z IS IN 11
	MOVEM	12,PTR+=252
	MOVE	12,PTR+=250  	; 1751	X=ITEM+1
	AOJ	12,	    	; X IS IN 12
	HRRZI	13,DPY+=4000   	; JX=WDS(X22+1)-WDS(X22)
	ADD	13,DL	
	MOVE	14,(13)   	; WDS(X22+1) IN 14  ADR. WDS(X22) IN 13
	SUB  	14,-1(13)	;JX IN 14
	HRRZI	10,DPY+=4000     	;  J=WDS(X+1)-WDS(X)
	ADDI	10,(12)
	MOVE	7,(10)		;WDS(X+1)
	SUB	7,-1(10)		;J IN 7
	MOVEM	7,MVBX		; STORE J
	SUB	7,14    	; Y=J-JX
	MOVE	14,-1(10)  	;  JX=WDS(X)+Y+1
	ADD	14,7
	AOJ	14,		; JX IN 14
	JUMPL	7,J2851   	;  IF(Y)2851,182,282
	JUMPE	7,J182
	MOVE	15,(10) ;282  CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
	ADDI	15,2	  	; ARG 1
	MOVE	6,-1(13) 	;  ARG 2
	JSA	16,LOOP
	JUMP	15
	JUMP	6 
	JUMP	[-1]
	JUMP	7	  	; Y
	JUMP	[0]
	JUMP	DPY
	JRST	J182   		;  GO TO 182
J2851:	MOVE	14,(13) ;2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
	ADD	14,7		;+Y
	ADDI	14,1		; ARG 1
	MOVE	5,-1(10) 	;WDS(X)
	ADD	5,7
	ADDI	5,1		; ARG 2
	MOVNM	7,MVBEAM	; -Y IS STORED
	JSA	16,LOOP
	JUMP	14
	JUMP	5
	JUMP	[1]
	JUMP	[0]
	JUMP	MVBEAM
	JUMP	DPY
	MOVE	14,-1(10)  	; WDS(X)   JX=WDS(X)+1
	ADDI	14,1		; JX IN 14
J182:	MOVE	5,-1(13)  ;182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
	ADDI	5,1   	;WDS(X22)+1
	JSA	16,LOOP
	JUMP	[1]
	JUMP	MVBX
	JUMP	[1]
	JUMP	5  
	JUMP	14 
	JUMP	DPY
	MOVE	2,DL    	; DO 183 K=X22+1,X
					; 183	WDS(K)=WDS(K)+Y
	HRRZI	3,PTR
	ADDI	3,(2)
J183:	JUMPE	11,J184		;IF(Z.EQ.0)GO TO 184
	ADDM 11,(3)		; PWDS(K)=PWDS(K)+Z
	AOJ	3,	;UPDATE PWDS AND WDS
J184:	JUMPE	7,J185
	ADDM 7,(13)
	AOJ 13,
J185:	CAIGE	2,(12)
	AOJA	2,J183			;ST(2)=WDS(X)
	MOVE 2,DPY+=3999(12)
	MOVEM 2,DPY+1
	SETZM	DL		;X22=0
	JRA	16,(16)

SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
	MOVEI	2,2	;DIMENSION RPOS(2,200)
S3:	MOVE	6,2	;(K=L HERE)
	SETO	11,	;L=2
	HRRZI	3,@(16)	;3	J=-1
	MOVE	4,2	;RX=RPOS(1,L-1)
	SUBI	4,1	;L-1
	IMULI	4,2
	ADDI	4,(3)
	MOVE	5,-2(4)	;RX
S2:	MOVE 	7,6	;	DO 2 K=L,M
				;IF(RPOS(1,K).GE.RX)GO TO 2
	IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
	ADDI	7,(3)
	CAMG	5,-2(7)
	JRST	S1	; CONTINUE
	MOVE	5,-2(7)	;  RX=RPOS(1,K)
;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
	MOVE 	11,6	;J=K
S1:	CAMGE	6,@1(16)	;2	CONTINUE
	AOJA	6,S2
	JUMPL	11,S4	;IF(J)GO TO 4
	MOVE	12,2	;K=L-1
	SOS	12
	IMULI	12,2	;(K*2)
	ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
	MOVE	10,-2(12)
	IMULI	11,2
	ADD	11,3
	EXCH	10,-2(11)
	MOVEM	10,-2(12)
	MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
	EXCH	10,-1(11)
	MOVEM	10,-1(12)
S4:	CAMGE	2,@1(16)	;4	L=L+1
	AOJA	2,S3		;IF(L.LE.M)GO TO 3
	JRA	16,2(16)	;END

XNOTE:	0		;FUNCTION XNOTE(J)
	MOVE 	3,@(16)		;COMMON/XRN/RN(4000)
	IMULI	3,12		;DIMENSION R(10,80)
					;EQUIVALENCE (R,RN(3001))
					;XNOTE=AMOD(R(4,J),100.)
	MOVE 2,RINP-7(3)
	JSA	16,AMOD
	JUMP	2
	JUMP	[=100.0]
	CAML [80.0]		;IF(XNOTE.GE.80)XNOTE=XNOTE-100
	FSBR [100.0]		; FOR NEG. MINIS, ETC.
	MOVE 2,RINP-1(3)	;GET R(10,J)
	JUMPE 2,.+5		;IF 0, RETURN
	MOVE 3,[5.0]		; ON STF ABOVE, +5 HGT.
	CAMN 2,[1.0]		; 1=STF BELOW
	MOVNS 3			; MAKE IT -5
	FADR 3			;ADD IT TO XNOTE
	JRA	16,1(16)	;END

BAUTO:	0		;	SUBROUTINE BAUTO(J,L,K,N)
			;C  FOR AUTOMATIC BEAMS.
	MOVEI 2,2 	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	ADDB 2,@(16)		;J=J+2
	MOVE	4,@1(16)
	SUB	4,@3(16)	;L-N
	MOVE	5,@2(16)
	SUB	5,@3(16)	;K-N
	FLTR 4,4		;TLC	4,232000
	MOVEM	4,SC+16(2)		;VX(J-1)=L-N
;**** A LIMIT OF 25 BEAMS PER LINE.
	FLTR 5,5		;TLC	5,232000
	MOVEM	5,SC+17(2)		;VX(J)=K-N
	JRA	16,4(16)

UPDATE:	0	;	SUBROUTINE UPDATE(I)
;;	HRRZI	3,XRN  ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
;;	ADD	3,PTR+=252	;RN(IS)=I
	MOVE 3,PTR+=252
	FLTR 2,@(16)		;MOVE	2,@(16)
	MOVEM 2,XRN-1(3)
				;IS=IS+I+3
	MOVE 2,@(16)
	ADDI 2,3
	ADDM 2,PTR+=252
	JRA	16,1(16)

IK:	0	;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
JIT:	0  ; THESE ARE TO STORE PNTRS IN LOOP
NEWR:	0	;	SUBROUTINE R
	MOVE	A,SC+=70	;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
	CAIE	A,1		;COMMON/XRN/RN(4000)
	JRST	N1	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
	MOVEM JK,IK  ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
	MOVE JT,PTR+=250  ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
 	MOVEM	JT,JIT  	;DIMENSION R(10,80)	
N1:	MOVE	IS,IK		;EQUIVALENCE (R,RN(3001))
	MOVEM	IS,PTR+=252
	MOVE 14,[9999.0]
	MOVE 	JT,JIT		;IF(MODE.NE.1)GO TO 1
	ADDI	JT,1		;IK=IS
	MOVEM	JT,PTR+=250	;HOMER=ITEM
	MOVEI	K,=10		;1	IS=IK
	MOVE	IZ,SCX+=41	;ITEM=HOMER+1 ******************** WAS +=33
	IMULI	IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
;;N2:	HRRZI	R,XRN+=2997	;DO 2 K=1,IZ
;;;;N2:	MOVE	R,XRN+=2997(K)	;DO 2 K=1,IZ
;;	ADD	R,K		;IF(R(8,K).EQ.9999.)GO TO 2
N2:	CAMN 14,RINP-3(K)
	JRST	NN2  ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
	SETO	IEND,		;C  JUMP FOR BEAM CONT.
;;	HRRZI	L,XRN		;IEND=-1
	MOVE IS,RINP-=10(K)	;GET CODE NUM. FROM R(1,K)
	CAMN IS,[1.0]		;IF IT IS 1, IEND=0
	SETZ IEND,
	MOVE L,PTR+=252		;RN(IS+3)=0
	SETZM XRN+2(L)		;RN(IS+2)=0
	SETZM XRN+1(L)
;;	SETZM LOOP		;LOOP=0    FOR P2→P11 TRANSFER
	MOVEI	L,=10 ;C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
	MOVE A,SC+=70		;LK=10 IF(MODE.GT.3)L=7
	CAIL A,4
	MOVEI L,7		;ONLY LOOK AT 7 PARAMS AFTER MODE 3.
N3:	HRRZI	R,RINP(K)   	;DO 3 L=LK,1,-1
	ADDI	R,(L)		;A=R(L,K)
	MOVE A,-13(R)		;(OCTAL) =13
	JUMPGE	IEND,NX4	;IF(A.NE.0)GO TO 77
	JUMPN	A,NX3		;IF(IEND)GO TO 3
	JRST	NN3
NX3:	MOVE	IEND,L		;77	IF(IEND)IEND=L
NX4:	MOVE R,PTR+=252
	ADDI R,(L)
	MOVEM A,XRN-1(R)	;RN(IS+L)=A
NN3:	CAILE	L,1		;3	CONTINUE
	SOJA	L,N3
	MOVE A,SCM+=80		;A=STAFF #
	MOVEM A,XRN(R)		;PUT IT IN P2
	CAME IS,[1.0]		;IF NOT CODE 1, SKIP OVER
	JRST N4
	MOVEI IEND,=11		;SET WDCNT
	MOVE A, RINP-9(K)	;GET WHAT'S IN R(2,K)
	MOVEM A,XRN+=9(R)	;PUT IT IN P11
;;N4:	SKIPE A,LOOP
;;	MOVEM A,XRN+=9(R)	;IF(LOOP.NE.0)RN(IS+11)=LOOP (REAL) 
N4:	CAIGE	IEND,3
	MOVEI	IEND,3
	MOVE	15,IEND		;IF(IEND.LT.3)IEND=3
	SUBI	15,2
	MOVE SC+=70	  ;IF(A NOTE AND MODE.EQ.3)R(9,K)=PTR TO P11 OF NT.
	CAMN IS,[1.0]
	CAIE 3
	JRST NN4  
	MOVE 0,R
 	ADDI =10
	FLTR 0			;USE THIS IN SLUR ROUTINE
	MOVEM RINP-2(K)
NN4:	JSA 	16,UPDATE	;CALL UPDATE(IEND-2)
	JUMP	15
NN2:	CAML	K,IZ		;2	CONTINUE
	JRA	16,(16)		;END
	ADDI	K,=10
	JRST	N2

CNT:	0
MSSLUP:	0
	SETZ	1,		;161	CNT=1
	SETZ	2,
L5543:	MOVE	3,.COMM.+4(2)	;DO 5543 K=1,10
;;	MOVE	3,(3)		;RA=RJQ(K)
	SKIPE	3		;IF(RA.NE.0)CNT=K
	MOVE	1,2
;;	MOVEI	4,RRJJ+1	;5543	RJJ(K)=RA
	MOVEM 3,RRJJ+1(2)
	CAIG	2,=8		; LOOP BACK?  
	AOJA	2,L5543
	AOJ	1,	;********* WILL SAVE UP TO PARAM 12 ONLY!
	MOVEM	1,CNT		;REMEMBERS CNT
	JRA	16,(16)

LUP2:	0
;;	MOVEI	1,XRN		;261	RN(I)=CNT
;;	ADD	1,PTR+=252
	FLTR 2,CNT		;MOVE	2,CNT
	MOVE 1,PTR+=252
	MOVEM 2,XRN-1(1)
	FLTR 2,.COMM.+1		;MOVE	2,.COMM.+1	;RN(I+1)=JA
					;I=I+2
	MOVEM 2,XRN(1)
	ADDI 1,2
	MOVEM 1,PTR+=252
	MOVE	3,.COMM.	;RN(I)=R2
	MOVEM 3,XRN-1(1)
;; NOT USED NOW!	IF(RD.NE.0)RN(I)=RD
;;C TO SAVE NOTE NUMBS IN P2.
	SETZ	5,		;DO 4554 K=1,CNT
L4554:	MOVE 2,.COMM.+4(5)
;;L4554:	MOVEI	2,.COMM.+4	;(RJQ)
;;	MOVEM	2,(3)		;4554	RN(I+K)=RJQ(K)
	MOVE 3,1
	ADDI 3,(5)
	MOVEM 2,XRN(3)
	AOJ	5,
	CAME	5,CNT
	JRST	L4554
	AOJ	5,
	ADDM 5,PTR+=252		;3554	I=CNT+1+I
	JRA	16,(16)

;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
;;	SUBROUTINE HOMER
;;	IMPLICIT INTEGER(A-Q,S-Z)
;;	REAL PWDS,DISX,A,B,PLACE,STFF
;;	COMMON /STF/RSTFAC(-3/4),RSTJ2
;;    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
;;	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
;;	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
;;	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
;;	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
HOMER:	0		; IF(JA.EQ.6)GO TO 9
	MOVE	MM,.COMM.+1
	CAIN	MM,6
	JRST	H9
	SKIPE	.COMM.+=14	;IF(R13.NE.0)GO TO 10
	JRST	H10	; FOR GENL HOMING; WORDS;  BEAMS;  STEMS;

;  ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
;  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
	JSA 16,HOMX
	JRA 16,(16)

H9:	SKIPGE	.COMM.+=32	;9	IF(J11.LT.0)RETURN
	JRA	16,(16)		;   IF P11=-1 NO HOMING
	MOVM	R,.COMM.+=28	;	X=IABS(J7)/10  CC  X=R7/10.
	IDIVI	R,=10		;;;FDVR	R,[=10.0]
	SKIPN 2,.COMM.+=31	;IF(J10.EQ.0)GO TO H100
	JRST H100
	CAIL 2,=10		;IF(J10.GE.10)X=0 (=LOOK AT ALL STEM DIRS.)
	SETZ R,
H100:	MOVEM	R,XNOTE		;X SAVED IN XNOTE = STEM DIR. OF BEAM.
;  R9= POS3
;XXX	MOVNI	RC,1	;RC=-1 
;XXX	SKIPE	.COMM.+=10	;IF(R9.NE.0)RC=-2  ****OR .GT. *******
;XXX	MOVNI	RC,2
;???	MOVE .COMM.+=11		;GET  P10
;???	JUMPE H10		;IGNORE IF 0
;CCC	SKIPLE .COMM.+=8	; SKIP IF R7 IS .LE.0
;CCC	MOVNI	RC,3		;  RC=0 ESCAPES FRCOM LOOP.
;   HOMING RANGE FOR BEAMS
H10:	SKIPN NX,.COMM.+=12	; 10	IF(R11.EQ.0)R11=2.9
	MOVE	NX,[=2.9]
	MOVEM	NX,.COMM.+=12	;   IF P11.NE.0 RANGE IS CHANGED FROM 2
	SETZ IZ,
;XXHX10:	MOVE	IZ,.COMM.+1	;	IF(JA.EQ.5)RC=-1
;XXX	CAIN	IZ,5
;XXX	MOVNI	RC,1
HX10:	MOVEI	K,1
	SETZ RC,
	MOVE L,.COMM.+1		; JA IS NOW IN L
	CAIN L,5
		SETO RC,
H361:	JSA	16,FINDIT		;DO 361 K=1,ITEM
	JUMP	K
	JUMPL	0,HX361		;IF(FINDIT(K))GO TO 361
;  SKIPS NOTES ON WRONG LINE 
	MOVEI	R,XRN		;RD=RN(L+3)
	ADD	R,PTR+=251	;LOC OF RN(L+1)
	MOVE	A,2(R)		;RD IN A
	MOVEM	A,RMOD+=9	;1	IF(JA.NE.6)GO TO 177
	KIFIX	JK,4(R)		;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
	IDIVI JK,=10		;JK=NOTE'S STEM DIRECTION
	CAIE	L,6
	JRST	H177
	JUMPE JK,HX361		;IF(RN(L+5).LT.10)GO TO HX361 (NO STEM)
	SKIPN XNOTE		;IF(XNOTE.EQ.0)GO TO H177
	JRST H177		;XNOTE=0 = CHECK ALL STEM DIRS.
	CAMN JK,XNOTE	  ;ARE STEM DIR,S SAME?
	JRST H377	  ;YES, JUMP
	MOVE -1(R)
	CAML [8.0]
	SKIPN JT, =9(R)		;JT='OTHER STAFF' INFO 2=↑  1=↓
	SKIPA
	JRST HH377		;IF(RN(L+10).EQ.0)GO TO H377

	MOVE .COMM.+5	;LEFT HEIGHT OF BEAM
	FADR .COMM.+6	;RIGHT HEIGHT
	FDVR [2.0]	;AVERAGE HEIGHT OF BEAM
	FSBR 3(R)	;SUBTR HEIGHT OF NOTE
	CAIE JK,1	;IF NOTE STEM DOWN, REVERSE SIGN
	MOVNS
	CAMG [8.0]	; IF DIFF. IS LESS THAN 8 DON'T HOOK BEAM TO STEM.
	JRST H377

;;	SKIPN XNOTE		;IF(XNOTE.EQ.0)GO TO H177
;;	JRST H177		;XNOTE=0 = CHECK ALL STEM DIRS.
;;	MOVE -1(R)
;;	CAML [8.0]
;;	SKIPN JT, =9(R)		;JT='OTHER STAFF' INFO 2=↑  1=↓
;;	JRST H377		;IF(RN(L+10).EQ.0)GO TO H377
;;	CAMN JK,XNOTE
;;	JRST H377
HH377:	MOVE 1,[2.44]
	FMPR 1,STF+=8	;*RSTJ2
	MOVM NN,.COMM.+=25	;IF(ABS(J4.GE.100)  *.6   (MINI)
	CAIL NN,=90   
	FMPR 1,[0.6]
	CAIE JK,1
	MOVNS 1
	FADR A,1	; ADD OR SUB. NOTE WIDTH FROM NOTE POS.
	JRST H177	;ALL NOTES ON 'DIFF. STF' ARE CONSIDERED.
H377:	CAME	JK,XNOTE
	JRST	HX361
H177:	JSA	16,PLACE	;177	IF(PLACE(R3))GO TO 461
	JUMP	.COMM.+4
	JUMPG HXX
	CAIE L,5	; DO NEXT IF HOMING SLUR
	JRST H461
	JSA 16,PLACE	;ALSO CHECK FOR P6 (RT. END OF SLUR)
	JUMP .COMM.+7
	JUMPL H461	; IF NEG. = DIDN'T FIND IN THAT AREA
	MOVEI .COMM.+7	; GET LOC. OF P6
	SKIPA
HXX:	MOVEI .COMM.+4  	;LOC. OF P3
	MOVEM NX 	;SAVE LOC. OF EITHER P3 OR P6
	SETO IZ,
HX2:	MOVE 5(R)	;GET PARAM 6
	CAMGE [10.0]	; MUST BE .GE.10 
	JRST HX1
	MOVE IS,[2.44]	; SIZE OF A NOTE
	CAML [20.0]	; 10 = RIGHT SHIFT, 20 = LEFT SHIFT
	MOVNS IS
	MOVM 3(R)		; GET P4
	CAML [100.0]		; IS IT A MINI?
	CAML [200.0]
	SKIPA
	FMPR IS,[0.6]		;*RMINI
	MOVE 1,.COMM.+3		;STAFF #
	FMPR IS,STF(1)	;*RSTFAC(J2)
	FADR A,IS
HX1:	JUMPG IZ,HX8	; JUMP TO CHANGE P6, 8 OR 9
HX3:	MOVEM	A,(NX)  	;R3=RD (OR R6)
;;HX3:	MOVEM	A,.COMM.+4	;R3=RD
;  LOOKS FOR NOTE, STAFF #, STEM DIR.
	MOVN .COMM.+=14		;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
	SKIPG			;IS IT NEG.
	JRST H11		; NO, GO TO NEXT SECTION.
	MOVEI JT,.COMM.+4	;GET LOC. OF R3
	MOVE IS,3(R)	; VERTICAL POS OF NOTE (P4)
	CAME [1.0]	;IS P13 -1 OR -2?
	JRST H12	;IT'S -2
	MOVE [2.0]
;;	CAIE  JK,2		;WHICH WAY IS STEM? 2=STEM DOWN
	SKIPG .COMM.+=8		;JUMP IF SLUR CURVES UP (STEMS DOWN) IN P7
	MOVNS		;ELSE MAKE DISPLACEMENT NEG.
	FADR IS		;ADD NOTE LEVEL
;;	MOVEM .COMM.+5		;P4=NOTE LEVEL + OR - 2.
;;	JRST H11
	JRST HZ
H12:	MOVE IZ,7(R)	; STEM LENGTH
	CAMN IZ,[999.0]   ; WHAT ABOUT 16TH AND 32ND NOTES??
	SETZ IZ,
	FADR IZ,[8.0]
	JSA 16,AMOD
	JUMP 6(R)
	JUMP [10.0]	;AC0=AMOD(R7,10.0)
	SKIPN
	JRST H13
	FSBR [1.0]	;IGNORE 1ST TAIL
	FMPR [1.8]	; *SPACE FOR EACH TAIL
	FADR IZ 	; ADD TO STEM LENGTH
H13:	CAIL JK,2	; <2 = STEM UP
	MOVNS 		;PUT IT UPSIDE DOWN.
	FADR IS   	;ADD NOTE LEVEL
;;	MOVEM IS,.COMM.+5	;PUT IT BEYOND STEM
HZ:	CAME JT, NX		;ARE WE LOOKING AT R3 OR R6 (JT=R3)
	JRST .+3	;JUMP FOR R6
	MOVEM   .COMM.+5	;PUT VERT. POS. INTO R4
	SKIPA
	MOVEM .COMM.+6	;PUT VERT. POS. INTO R5

H11:	CAIN	L,6		;IF(JA.EQ.6)GO TO 861
	JRST	 H861
	CAIN	L,5		;IF(JA.EQ.5)GO TO 261
	JRST	HX361
;XXX	JRST	H261
	JRA	16,(16)		;RETURN
H461:	CAIN	L,6		;461	IF(JA.EQ.6)GO TO 277
	JRST	H277
	CAIE	L,5		;IF(JA.NE.5)GO TO 361
	JRST	HX361
H277:	JSA	16,PLACE	;277	IF(PLACE(R6))GO TO 561
	JUMP	.COMM.+7
	JUMPL	H561
	MOVEI IZ,7		;R6=RD
	JRST HX2
H861:	MOVE	0,.COMM.+=28	;861	IF(J7.GE.0)GO TO 261
	JUMPGE	0,HX361
;XXX	JUMPGE	0,H261
H561:	JSA	16,PLACE	;561	IF(PLACE(R9))GO TO 661
	JUMP	.COMM.+=10	;R9
	JUMPL	H661
	MOVE	0,.COMM.+=28	;IF(J7)GO TO 761
	JUMPL	H761	;  J7=NEG MEANS TREMOLO
	MOVE	0,.COMM.+=9	;	IF(R8.NE.0)GO TO 761
	JUMPN	H761
	MOVE	0,.COMM.+=11	;	IF(R10.EQ.0)GO TO 361
	JUMPE	HX361
H761:	MOVEI IZ,=10		;761	R9=RD
	JRST HX2
;  R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.    ; GO TO 261
H661:	CAIN	L,5		;661	IF(JA.EQ.5)GO TO 361
	JRST	HX361
;;	MOVE	0,.COMM.+=31	;IF(J10.LT.30)GO TO 361
;;	CAIGE	0,=30
	SKIPN .COMM.+=31	;IF J10.EQ.0 GO TO 361
	JRST	HX361
	JSA	16,PLACE	;IF(PLACE(R8))GO TO 361
	JUMP	.COMM.+=9
	JUMPL	HX361	; HOMES INNER PARTIAL BEAMS
	MOVEI IZ,=9		;R8=RD
	JRST HX2
HX8:	MOVEM	A,.COMM.(IZ)	;PUT A INTO RIGHT PARAM.
;XXXH261:	SKIPN	RC       	;261	IF(RC.EQ.0)RETURN
;XXX	JRA	16,(16)    
;XXX	AOJ	RC		;RC=RC+1
HX361:	CAMGE	K,PTR+=250	;361 	CONTINUE
	AOJA	K,H361
	JRA	16,(16)		;	END

CODN:	0		;FUNCTION CODN(K,N)
	MOVE 1,@(16)		;GET CODE NUMBER AND RETURN POINTER
	MOVE 2,PTR-1(1)		;L=KWDS(K)
	MOVEM 2,@1(16)
	MOVE XRN(2)		;CODN=RN(L+1)
	JRA 16,2(16)

FSCAN:	0
	INCHRW
	MOVE 2,[ASCII/     /]
	MOVEM 2,ALF
	MOVE 2,[XWD ALF,ALF+1]
	BLT 2,ALF+=71			; CLEANS OUT INP ARRAY
	CAIN ";"
	JRA 16,(16)
	CAIN ":"
	JRA 16,1(16)
	CAIN "("
	JRA 16,2(16)
	CAIN ")"
	JRA 16,3(16)
	CAIN "/"
	JRA 16,4(16)
	CAIN "*"
	JRA 16,5(16)
	CAIN "X"
	JRA 16,6(16)
	CAIN "C"
	JRA 16,7(16)
	JRA 16,8(16)


NALF:	0
	MOVE 0,@(16)
	JUMPGE .+4		;IF(I.GE.0)GO TO 20
	MOVE 1,[405004020100]	;  J='A'=405004020100
	SETO 2,			; M=-1
	JRST .+3		;GO TO 10
	MOVE 1,[201004020100]	;20  J=' '=201004020100
	MOVEI 2,=16		; M=16
	SUB 0,1			;10 NALF=(I-J)/536870912-M
	IDIV 0,[3777777777]	
	SUB 0,2
	JRA 16,1(16)

BOX:	0    	;CALL BOX(I,R)   SEE PLTSRT.F4 FOR FORTR. VERSION
	MOVE 14,@(16)	; I IS IN 14
	JUMPL 14,BX4
	KIFIX 13,@1(16)	;K=R	;MOVE 13,@1(16)	; GET R
	JSA 16,AMOD
	JUMP XRN+3(14)	; GET REAL P4
	[100.0]
	CAMGE [-20.0]	;IF(P4.LT.-20)P4=P4+100
	FADR [100.0]	; FOR P4=-95 ETC.
	CAML [80.0]	;IF(P4.GE.80)P4=P4-100
	FSBR [100.0]	; CATCHES NEG. MINIS, ETC.
	FMPR [7.0]
	FMPR STF(13)	;*STAFF FACTOR
	FADR POSI(13)	; + STAFF VERT. POS.
	FSBR [40.0]	;  SHIFT CURSOR DOWN A BIT.
	FMPR SIZ
	KIFIX 13,0	
	SUB 13,SIZ+2	;13=K
	JSA 16,RHORZ	; GET HORIZ. POS.
	JUMP XRN+2(14)
	FMPR SIZ	;SIZ IS FOR ZOOMED IMAGES
	KIFIX 12,0		;MOVE 12,	;  12=L
	SUB 12,SIZ+1
	CAIL 12,=550	; CHECK IF OUT OF BOUNDS OF CRT
	MOVEI 12,=511
	CAMG 12,[-=550]
	MOVE 12,[-=511]
	JSA 16,SETCUR
	12
	13
	[0]
	JRA 16,2(16)	; THE CURSOR IS IN POSITION
BX4:	CAME 14,[-1]
	JRST BX5
	JSA 16,DPYSET
	[3]
	RINP
	[=100]
	JSA 16,DPYBRT
	[3]
BX5:	MOVE 2,@1(16)	; GET R
	JSA 16,RHORZ
	2
	FMPR SIZ
	KIFIX 0,0
	SUB SIZ+1
	MOVM 2,
	CAILE 2,=550
	JRST BX6
	MOVEM 0,LOOP
	JSA 16,SETPOG
	[3]
	JSA 16,ALINE
	LOOP
	[-=511]
	LOOP
	[=511]
	JSA 16,DPYOUT
	[3]
BX6:	JSA 16,SETPOG
	[1]
	JRA 16,2(16)

PARCH:	0		;CALL PARCH(JA,JJA,RD)
	MOVE 2,@(16)	;GET JA
	CAIN 2,2	;IS IT P2
	JRST .+8
	CAIE 2,1	;IS IT P1
	JRA 16,3(16)	;NEITHER
	KIFIX 3,@2(16)	;GET RD
	JUMPE 3,.+3	; REJECTS CODE # 0.
	CAIG 3,=18	;IS PARAM .GT.18?
	MOVEM 3,@1(16)	;PUT IT INTO JJA
	JRA 16,3(16)	;ALL DONE
	MOVE 3,@2(16)	;GET RD
	CAMG 3,[7.0]	;REJECTS STAFF # .GT.7
	MOVEM 3,RRJJ	; PUT IT AWAY
	JRA 16,3(16)

	END